home *** CD-ROM | disk | FTP | other *** search
/ PD Collection CD 1 / PD Collection CD 1.iso / programer2 / sml / !Sml_Sml_core_array < prev    next >
Encoding:
Text File  |  1990-07-04  |  2.3 KB  |  76 lines
  1. (* RJG - for loading into smlcore *)
  2.  
  3.  (* Diags *)
  4. (*    local val {StdOut, ...} = CurrentState()
  5.     in    fun PStr str = Writestream(StdOut, str)
  6.           fun PInt int = PStr((makestring:int->string) int)
  7.     end
  8. *)
  9.     exception Range
  10.  
  11. local
  12.    nonfix bytearray_create 160 1;
  13.    nonfix store_byte 230 3;
  14.    nonfix fetch_byte 226 2;
  15.    nonfix extract_ 101 3; 
  16. in
  17.     abstype bytearray = BA of string
  18.     with
  19.  
  20. local
  21.     type ba_repr = string        (* the representation *)
  22.     fun bytearray_create(n: int): ba_repr = bytearray_create(n);
  23.     fun store_byte(x:int,y:ba_repr,z:int):unit = store_byte(x,y,z)
  24.     fun fetch_byte(x:int,y:ba_repr):int = fetch_byte(x,y)
  25.     fun extract_(x: ba_repr, y: int, z: int) = extract_(x, y, z)
  26. in
  27.     fun bArray(size, initval): bytearray =
  28.       if initval < 0 orelse initval > 255 then raise Range
  29.       else if size < 0 then raise Subscript
  30.       else let val newarr = bytearray_create(size) 
  31.             fun initarr index = 
  32.               if index >= size then newarr
  33.               else ( store_byte(initval,newarr,index); initarr(index+1) ) 
  34.          in BA(initarr 0) end
  35.  
  36.     fun bUpdate(BA ba: bytearray, pos: int, value: int): unit =
  37.       if pos < 0 orelse pos >= (size ba) then raise Subscript
  38.       else if value < 0 orelse value > 255 then raise Range
  39.       else store_byte(value,ba,pos);
  40.  
  41.     fun bLength(BA ba) = size ba
  42.  
  43.     infix bSub
  44.     fun (BA ba) bSub (pos: int): int =
  45.       if pos < 0 orelse pos >= (size ba) then raise Subscript
  46.       else fetch_byte(pos,ba)
  47.  
  48. (*    fun extract(BA x,y,z) =
  49.        extract_(x,y+1,z) handle Substring => raise Subscript*)
  50.  
  51.     fun bApp f (BA ba) = 
  52.       let val len = size ba
  53.           fun app'(i) = 
  54.             if i >= len then ()
  55.             else (f(fetch_byte(i,ba)); app'(i+1))
  56.        in app'(0) end;
  57.  
  58.     fun bRevapp f (BA ba) = 
  59.       let fun revapp'(i) = 
  60.             if i < 0 then ()
  61.             else (f(fetch_byte(i,ba)); revapp'(i-1))
  62.        in revapp'(size ba-1) end;
  63.  
  64.     fun bFold f (BA ba) x =
  65.       let fun fold'(i,x) = 
  66.           if i < 0 then x else fold'(i-1,f(fetch_byte(i,ba),x))
  67.        in fold'(size ba-1, x) end;
  68.  
  69.     fun bRevfold f (BA ba) x = 
  70.       let val len = size ba
  71.           fun revfold'(i,x) =
  72.             if i >= len then x else revfold'(i+1,f(fetch_byte(i,ba),x))
  73.        in revfold'(0,x) end
  74.     end (*local*)
  75.    end   (* abstype *)
  76. end; (* local *)